home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / forth / amiga / amigaker.arc / Forth.asm < prev    next >
Assembly Source File  |  1987-12-30  |  10KB  |  260 lines

  1.  
  2.  
  3.  
  4. ;02May87pja  Altered; can now supply a hex number after the startup
  5. ;            command to specify the size of the user dictionary. Default
  6. ;            is 64k. Can also supply a line which is interpreted at startup
  7. ;            after the number, if supplied. This can supply a load command
  8. ;            for instance. Any regular command can be executed.
  9. ; examples: 1> run Forth A000 load assem.txt
  10. ;           1> run Forth load editor.txt
  11. ;           1> run Forth 20000 cr .( hi ) cr
  12.  
  13. ;04Apr87pja  Changed, to use regular files.
  14.  
  15. *                 ForthII.asm           09Mar86pja
  16.  
  17. ; -----------------------------------------------------------------------
  18.  
  19. ; LABELS
  20.  
  21. ;  Labels starting with an underline are the CFA address of the Forth
  22. ;  word.
  23. ;  Other labels are internal to the assembly.
  24. ;  Forth words to interface to the romcalls are identical to the rom
  25. ;  manuals, but the stack picture is according to the MOVEM.L instruction
  26. ;  ( why didn't Amiga do it that way, and supply a mask for each routine? )
  27. ;  this is different to the C-language way of calling the routines.
  28.  
  29. ;  This assembler does not allow special character in the labels.
  30. ;  Therefore names like + become _plus and ! becomes _store etc.
  31.  
  32. ;**********************************************************************
  33.  
  34.                   SECTION  ForthII
  35.  
  36. ;                  register equates
  37. ;
  38. rp                equr     A6
  39. ip                equr     A5
  40. w                 equr     A4
  41.  
  42. ;                 Note: A3 is reserved to hold the address of NEXT, this
  43. ;                       way a jump to next becomes: jmp (a3)
  44.  
  45. immediate         equ      1<<6     ;flag to set the immediate bit of
  46.                                     ;a word.
  47. delayed           equ      0        ;the opposite of immediate
  48.  
  49. rpstacksize       equ      1024     ;stack size for return pointer
  50.  
  51. ;NOTE: The standard stacksize is set by dos. I use 8k and have had no
  52. ;      problems.
  53.  
  54.  
  55. ;************************************************************************
  56.  
  57.                   SECTION  ForthII,BSS
  58.  
  59. keybuffer         ds.b     32       ;buffer for console input
  60.                   ;raw keypresses are put here by calling SendIO, and
  61.                   ;are collected by forth word 'key'.
  62.  
  63. stdbuffer         ds.b     256      ;buffer for output
  64.                   ;A scratch buffer used to output single characters (emit)
  65.                   ;or multiple characters (e.g. spaces,words)
  66.  
  67. tibbuffer         ds.b     256      ;buffer for terminal input
  68.                   ;The forth input buffer, query, tib, source, are some
  69.                   ;of the words using the area.
  70.  
  71. rpstack           ds.b     rpstacksize     ;return stack, long enough?
  72.  
  73.  
  74. ;************************************************************************
  75.  
  76.  
  77.                   SECTION  ForthII,CODE
  78. ;
  79. ;
  80. ;
  81. link0             set      0        ;4 link pointer
  82. link1             set      0
  83. link2             set      0
  84. link3             set      0
  85. voc_link          set      0        ;and a vocabulary link, used to traverse
  86.                                     ;all the  vocabulary names.
  87. lib_link          set      0        ;links all the Amiga libraries together.
  88.  
  89. file_link         set      0        ;Files are linked to form a list.
  90. ;
  91. ;
  92. start_t           jmp      cold              ;COLD init routine
  93.                   jmp      warm              ;WARM entry point
  94.  
  95. ; next
  96. next              move.l   (ip)+,w           ;label - next
  97.                   move.l   (w)+,a0
  98.                   jmp      (a0)
  99.  
  100. ; The following section does the calling of romroutines.
  101. ; It is self modifying code. ( sorry ).
  102. ; The registers loaded from the stack is modified.
  103. ; The index for the jump is also modified.
  104. ; The Forth state is saved. (a0/a3-a5) on the return stack and the return
  105. ; stack is saved on the stack. Other registers are not important.
  106. ; If any routine returns a value in D0 it is pushed onto the stack if
  107. ; the flag romcallflag is set.
  108.  
  109. romcall           move.l   a0,d0             ;test for 0 lib.base
  110.                   beq      warm              ; reset the system then.
  111.                   movem.l  a0/a3-a5,-(rp)    ;save forth state
  112.                   movem.l  (sp)+,d0-d1       ;this is modified to load regs
  113. romcallx          move.l   a6,-(sp)          ;save rp
  114.                   move.l   (rp),a6           ; library base
  115.                   jsr      100(a6)           ;the index is also changed
  116. romcally          move.l   (sp)+,rp          ;restore rp
  117.                   movem.l  (rp)+,a0/a3-a5    ;restore forth state
  118.                   tst.w    romcallflag       ; if a value is returned
  119.                   beq.s    1$                ; save it on the stack
  120.                   move.l   d0,-(sp)
  121. 1$                jmp      (a3)              ; jump to next
  122.  
  123. romcallflag       dc.w     0                 ;reset if no value to return
  124.  
  125. ; To call a code word from within a code word and have it return to the
  126. ; caller, the following routine can be used. Call it as follows:
  127. ;           lea _dup,w
  128. ;           jsr callword
  129. ; No need to save any registers, unlike the callrom routine, see
  130. ; 05.romcalls, for that.
  131. ; This routine allows for nesting of these type of calls, using two cells
  132. ; for each nesting on the return stack. Take note that no routine is aborted
  133. ; by using "r> drop", that will not work properly. Watch for loops.
  134. ;
  135. ; It is not very efficient to use this extensively. Calls to code words
  136. ; at the end of the calling code word are better jumped to with a branch
  137. ; instruction. e.g. bra _dup+4.
  138. ;
  139. ; The advantage? The words execute faster. Each high level call in a
  140. ; colon definition has an overhead of 24 cycles. This is the 'next' routine
  141. ; For instance, dup can be done faster if coded as: move.l (sp),-(sp)
  142. ; The total time to execute from within a colon word is 24+20 and code is
  143. ; 20, a saving of 24 cycles. A greater saving is in branching and testing
  144. ; of stack components. The stack can be accessed in code like: tst.l 8(sp)
  145. ; that can save a 'rot dup >r -rot' sequence.
  146. ; Most code words can be bypassed using code in each word. The size
  147. ; savings are minimal!!! The callword routine should be used sparingly and
  148. ; only in cases where the called word is a sizable word. If used extensively
  149. ; the code word reverts to a hacked up next-like routine with a much larger
  150. ; overhead then next.  Next is much more efficient.
  151.  
  152. ; I know!! There are better methods, and in the future I'll use one.
  153. ;
  154. callword          move.l   a3,-(rp)          ;save current next address
  155.                   move.l   (sp)+,-(rp)       ;save the callers address
  156.                   lea      callw_1,a3        ;will return there
  157.                   move.l   (w)+,a0           ;this will allow variable etc
  158.                   jmp      (a0)              ;   to work also.
  159.  
  160. callw_1           move.l   (rp)+,a0          ;where to return to
  161.                   move.l   (rp)+,a3          ;restore current next address
  162.                   jmp      (a0)
  163. ;
  164. ;
  165. * forth
  166.                   dc.w     -1
  167.                   dc.l     link2
  168. link2             set      *-4
  169.                   dc.b     $85,'fort',$80!'h'
  170.                   cnop     0,2
  171. _forth            dc.l     vocabulary_does   ;points to >does of Vocabulary
  172.                   dc.l     Link0             ;four hash links for voc.
  173.                   dc.l     Link1
  174.                   dc.l     Link2
  175.                   dc.l     Link3
  176.                   dc.l     voc_link          ;temporal linked list
  177. voc_link          set      *-4
  178.  
  179.                   include  "01.runtime"
  180.  
  181.                   include  "02.stack"
  182.  
  183.                   include  "03.math"
  184.  
  185.                   include  "04.vars"
  186.  
  187.                   include  "05.romcalls"
  188.  
  189.                   include  "06.console"
  190.  
  191.                   include  "07.dos"
  192.  
  193.                   include  "08.files"
  194.  
  195.                   include  "09.loading"
  196.  
  197.                   include  "10.terminal"
  198.  
  199.                   include  "11.number"
  200.  
  201.                   include  "12.parsing"
  202.  
  203.                   include  "13.dict"
  204.  
  205.                   include  "14.compiler"
  206.  
  207.                   include  "15.structs"
  208.  
  209.                   include  "16.defining"
  210.  
  211.                   include  "17.intuition"
  212.  
  213.                   include  "18.init"
  214.  
  215.                   include  "19.extend"
  216.  
  217.  
  218. ; define the newwindow structure at here, as soon as the window is opened
  219. ; it can be forgotten, or used as scratch area, except the windowname.
  220.  
  221. windowname        dc.b     'Forth',0
  222.                   cnop     0,2
  223.  
  224. here_window       dc.w     0,0,640,200
  225.                   dc.b     -1,-1
  226.                   dc.l     0,$1!$2!$4!$20!$1000!$20000  ;!$40
  227.                   dc.l     0,0,windowname,0,0
  228.                   dc.w     100,40,640,200,1
  229.  
  230. ;
  231. ; resolve all the links created in the assembly.
  232. ;
  233. Link0             equ      link0
  234. Link1             equ      link1
  235. Link2             equ      link2
  236. Link3             equ      link3
  237. execLink0         equ      execlink0
  238. execLink1         equ      execlink1
  239. execLink2         equ      execlink2
  240. execLink3         equ      execlink3
  241. dosLink0          equ      doslink0
  242. dosLink1          equ      doslink1
  243. dosLink2          equ      doslink2
  244. dosLink3          equ      doslink3
  245. intLink0          equ      intlink0
  246. intLink1          equ      intlink1
  247. intLink2          equ      intlink2
  248. intLink3          equ      intlink3
  249. rootLink0         equ      rootlink0
  250. rootLink1         equ      rootlink1
  251. rootLink2         equ      rootlink2
  252. rootLink3         equ      rootlink3
  253. Voc_link          equ      voc_link
  254. Lib_link          equ      lib_link
  255. File_link         equ      file_link
  256. ;
  257. ;
  258.                   END
  259.  
  260.